Green Regional Path paper: Dataviz

0.1 Setup

1 Initial preperation

1.1 Connect to database

# Not sure if necessary... was an issue with a version conflict... try new version in the future again...
# devtools::install_version("RPostgres", version = "1.2.1", repos = "http://cran.us.r-project.org")

### general options
Sys.setenv(LANG = "en")
options("scipen" = 100, "digits" = 4) # override R's tendency to use scientific notation

### Clean workspace
rm(list=ls())
graphics.off()

### Load packages (maybe need to be installed first)
# Standard
library(tidyverse) # General DS toolkit
library(magrittr) # For advanced piping

# Databases
library(DBI) # GEneral R database interface
library(RPostgres) # PostgreSQL interface driver 
library(dbplyr) # for dplyr with databases

# networks
library(tidygraph)
library(ggraph)
library(ggrepel)

# Load functions
source("functions/functions_relatedness.R")

# Load script with variables
source("../variables.R")

# set up connection to existing PostgreSQL database, just plug in own details
con <- dbConnect(drv = RPostgres::Postgres(), 
                 dbname = var_dbname,
                 host = var_host, 
                 port = var_port,
                 user = var_user, 
                 password = var_password,
                 sslmode = 'require'
                 )

rm(var_dbname, var_host, var_password, var_port, var_user)

1.2 Load data

# con %>% dbListTables() %>% sort()

1.3 Defining parameters

# Regular tables
data_appln <- read_rds('../temp/data_appln.rds')
data_docdb_fam_cpc <- read_rds('../temp/data_docdb_fam_cpc.rds')
data_pers_appln  <- read_rds('../temp/data_pers_appln.rds')
data_person <- read_rds('../temp/data_person.rds')
data_nace2 <- read_rds('../temp/data_nace2.rds')

# Adittional ones
g_tech <- read_rds('../temp/g_tech.rds')
region_RTA <- read_rds('../temp/region_RTA.rds')
region_tech <- read_rds('../temp/region_tech.rds')

n_regions = 7
cuttoff = 100

select_regions <- region_tech %>%
  group_by(nuts) %>%
  summarise(n = sum(weight_frac, na.rm = TRUE),
            n_Y = sum(weight_frac * Y_tag, na.rm = TRUE)) %>%
  ungroup() %>%
  mutate(share_Y = n_Y / (n + n_Y)) %>%
  filter(nuts %in% c('SE232', 'NO043', 'DK012')) %>%
  arrange(desc(n_Y))

2 Patent application development

# Restrict to top N regions
top_regions <- region_tech %>%
  group_by(nuts) %>%
  summarise(n = sum(weight_frac, na.rm = TRUE),
            n_Y = sum(weight_frac * Y_tag, na.rm = TRUE)) %>%
  ungroup() %>%
  mutate(share_Y = n_Y / (n + n_Y)) %>%
  #filter(n_Y >= cuttoff ) %>%
  arrange(desc(n_Y)) %>%
  slice(1:n_regions) %>%
  bind_rows(select_regions) %>%
  distinct()

data_appln %>%
  count(appln_filing_year, Y_tag) %>%
  ggplot(aes(x = appln_filing_year, y = n, col = Y_tag)) + 
  geom_line(key_glyph = "timeseries") +
  labs(title = 'Patent applications: Development',
       subtitle = 'All Nordic contries, by Y tag',
       x = 'Year',
       y = 'Number applications',
       col = 'Green')

3 Texnology space general

data_pers_appln %>%
  semi_join(top_regions, by = 'nuts') %>%
  count(appln_filing_year, nuts, Y_tag, wt = weight_frac) %>%
  ggplot(aes(x = appln_filing_year, y = n, col = nuts)) + 
  geom_line(key_glyph = "timeseries") +
  facet_wrap(vars(Y_tag), scales = 'free') +
  labs(title = 'Patent applications: Development',
       subtitle = 'All Nordic contries',
       x = 'Year',
       y = 'Number applications, by region and Y tag',
       col = 'Nuts3')

set.seed(1337)
coords_tech <- g_tech %>% igraph::layout.fruchterman.reingold() %>% as_tibble()
colnames(coords_tech) <- c("x", "y")

4 Specialization development

g_tech %N>%
  mutate(nace_group_name = nace_group_name %>% str_trunc(50, side = 'right')) %>%
  ggraph(layout =  coords_tech) + 
  geom_edge_link(aes(width = weight), alpha = 0.5, colour = "grey") + 
  geom_node_point(aes(colour = nace_sec_name, size = dgr)) + 
  geom_node_text(aes(label = nace_group_name, size = dgr, filter = percent_rank(dgr) >= 0.5 ), repel = TRUE) +
  theme_void() +
  labs(title =paste('Technology Space (all Nordics)'),
       subtitle = 'Nodes = NACE 2 Industries. Edges: Relatedness')

# dataframe with technology relatedness edgelist
tech_rel <- g_tech %E>%
  mutate(from_nace = .N()$name[from],
         to_nace = .N()$name[to]) %>%
  as_tibble() %>%
  mutate(from = from_nace %>% as.character(),
         to = to_nace %>% as.character(),
         pct_rank = weight %>% percent_rank()) %>%
  arrange(from, to) 

tech_rel %<>%
  bind_rows(tech_rel %>% 
              rename(from_new = to, to_new = from) %>% 
              rename(from = from_new, to = to_new) %>%
              relocate(from, to)) %>%
  distinct(from, to, .keep_all = TRUE)

# Dataframe with regions and technology fields
tech_dev <- region_RTA %>%
  select(period, nuts, nace_group, Y_tag, n_tech_region, rta, rta_bin) %>%
  arrange(nuts, nace_group, Y_tag, period) 

p1 <- region_RTA %>%
  semi_join(top_regions, by = 'nuts') %>%
  group_by(nuts, period, Y_tag) %>%
  summarise(n_spec = rta_bin %>% sum(na.rm = TRUE),
            n_spec_count = (n_tech_region * rta_bin) %>% sum(na.rm = TRUE),
            HHI = sum((n_tech_region/sum(n_tech_region) * 100)^2) ) %>%
  ungroup() %>%
  #group_by(nuts, period) %>%
  #summarise(Y_share = sum(Y_tag * n_spec, na.rm = TRUE) / sum(n_spec, na.rm = TRUE),
  #          Y_count = sum(Y_tag * n_spec_count, na.rm = TRUE)) %>%
  #ungroup() %>%
  mutate(nuts_period = paste(nuts, 'P', period)) %>%
  pivot_wider(names_from = Y_tag, values_from = c(n_spec, n_spec_count, HHI), values_fill = 0, names_prefix = 'Y_tag_') 

`summarise()` has grouped output by 'nuts', 'period'. You can override using the `.groups` argument.

p2 <- p1 %>% 
  select(period, nuts, n_spec_Y_tag_FALSE, n_spec_Y_tag_TRUE) %>%
  pivot_wider(names_from = period, values_from = c(n_spec_Y_tag_FALSE, n_spec_Y_tag_TRUE))

p1 %>%
  ggplot(aes(x = n_spec_Y_tag_FALSE, y = n_spec_Y_tag_TRUE)) +
  geom_point(aes(size = n_spec_count_Y_tag_TRUE, col = HHI_Y_tag_TRUE)) +
  geom_text(aes(label = nuts), position = position_dodge(0.9), alpha = 0.75) +
  geom_segment(data = p2, 
               aes(x = n_spec_Y_tag_FALSE_1,
                   y = n_spec_Y_tag_TRUE_1,
                   xend = n_spec_Y_tag_FALSE_2,
                   yend = n_spec_Y_tag_TRUE_2,
                   size = 1),
               alpha = 0.15,
               arrow = arrow(length = unit(0.5, "cm"), type = "closed"),
               show.legend = FALSE) +
  scale_color_gradient2(low = "skyblue", mid = 'yellow', high = "red", midpoint = 1) +
  labs(title = '', 
       subtitle = '',
       note = '',
       x = 'N non-green specializations',
       y = 'N green specializations',
       size = 'N green patents',
       col = 'HHI green patents') 

5 Analysis for existing green paths:

rm(p2, p2)

Warning: object 'p2' not found

select_regions_green <- tech_dev %>%
  group_by(nuts, period) %>%
  summarise(green =  sum(Y_tag * rta, na.rm = TRUE),
            green_bin =  sum(Y_tag * rta_bin, na.rm = TRUE),
            n_tech_region =  sum(n_tech_region, na.rm = TRUE),
            n_green_region =  sum(Y_tag * n_tech_region, na.rm = TRUE),
            n_green_rta =  sum(Y_tag * n_tech_region * rta_bin, na.rm = TRUE)) %>%
  ungroup() %>%
  filter(n_green_rta >= 100,
         green_bin >= 1,
         period == '1') %>%
  select(nuts)

`summarise()` has grouped output by 'nuts'. You can override using the `.groups` argument.

tech_dev %<>% 
  group_by(nuts, nace_group, Y_tag) %>%
  mutate(rta_dev = case_when(
    rta_bin < lag(rta_bin, 1)  ~ -1,
    rta_bin == lag(rta_bin, 1)  ~ 0,
    rta_bin > lag(rta_bin, 1)  ~ 1 
  )) %>%
  ungroup()

tech_spec_dev <- tech_dev %>%
  filter(n_tech_region >= 50) %>%
  group_by(nuts, Y_tag) %>%
  summarise(rta_dev = rta_dev %>% sum(na.rm = TRUE)) %>%
  ungroup() %>%
  pivot_wider(names_from = Y_tag, values_from = rta_dev, values_fill = 0, names_prefix = 'Y_spec_')

`summarise()` has grouped output by 'nuts'. You can override using the `.groups` argument.

tech_rel_dev <- tech_rel %>% 
  select(from, to, weight) %>%
  left_join(tech_dev %>% distinct(nace_group, nuts), by = c('from' = 'nace_group')) %>%
  # filter for rta in period 1
  inner_join(tech_dev %>% filter(period == '1', rta_bin == 1) %>% select(nace_group, nuts, Y_tag), by = c('to' = 'nace_group', 'nuts')) %>%
  # filter for new green specialization in period 2
  semi_join(tech_dev %>% filter(period == '2', rta_bin == 1, rta_dev == 1, Y_tag == TRUE), by = c('from' = 'nace_group', 'nuts')) %>%
  rename(nace_group = from, related_techn = to) %>%
  group_by(nuts, nace_group, Y_tag) %>%
  summarise(rel_max = weight %>% max(),
            rel_sum = weight %>% sum(),
            rel_mean = weight %>% mean()) %>%
  ungroup()

`summarise()` has grouped output by 'nuts', 'nace_group'. You can override using the `.groups` argument.

tech_rel_dev %>%
  group_by(nuts, Y_tag) %>%
  summarise(rel = rel_max %>% mean()) %>%
  ungroup() %>%
  pivot_wider(names_from = Y_tag, values_from = rel, names_prefix = 'Y_', values_fill = 0) %>%
  left_join(tech_dev %>% filter(Y_tag == TRUE, period == '2', rta_bin == 1) %>% select(nuts , n_tech_region) %>% count(nuts, wt = n_tech_region), by = c('nuts')) %>%
  mutate(country = nuts %>% str_sub(1,2)) %>%
  #semi_join(top_regions, by = 'nuts') %>%
  filter(0.5 <= percent_rank(n)) %>%
  ggplot(aes(x = Y_FALSE, y = Y_TRUE, size = n)) +
  geom_point(aes(col = country)) +
  geom_text_repel(aes(label = nuts), box.padding = 0.5, max.overlaps = Inf) +
    labs(title = 'New green specialization period 2', 
       subtitle = 'By nuts regions',
       note = 'Relatedness is the mean over all new green specializations, per green specialization largest relatedness to former specialization counted',
       x = 'Relatedness non-green',
       y = 'Relatedness green',
       size = 'N green patents') 

`summarise()` has grouped output by 'nuts'. You can override using the `.groups` argument.

• Label 2nd figure on green, label coinciding, maybe rta, share or growth

6 Dataviz

tech_rel_dev %>%
  group_by(nuts, nace_group, Y_tag) %>%
  summarise(rel = rel_max %>% mean()) %>%
  ungroup() %>%
  pivot_wider(names_from = Y_tag, values_from = rel, names_prefix = 'Y_', values_fill = 0) %>%
  left_join(tech_dev %>% filter(Y_tag == TRUE, period == '2', rta_bin == 1) %>% select(nuts, nace_group, n_tech_region) %>% count(nuts, nace_group, wt = n_tech_region), by = c('nuts', 'nace_group')) %>%
  mutate(country = nuts %>% str_sub(1,2)) %>%
  semi_join(top_regions, by = 'nuts') %>%
  ggplot(aes(x = Y_FALSE, y = Y_TRUE, size = n)) +
  geom_point() +
  geom_text_repel(aes(label = nace_group), box.padding = 0.5) +
  facet_wrap(vars(nuts)) +
    labs(title = 'New green specialization period 2', 
       subtitle = 'By nuts regions',
       note = 'Relatedness is the mean over all new green specializations, per green specialization largest relatedness to former specialization counted',
       x = 'Relatedness non-green',
       y = 'Relatedness green',
       size = 'N green patents') 

`summarise()` has grouped output by 'nuts', 'nace_group'. You can override using the `.groups` argument.

i = 1; place <- regions[i]
time =  '1'

g_tech %N>%
  left_join(region_RTA %>% filter(nuts == place, period == time) %>% select(techn_field_nr, rca, rca_Y, n_tech_region), by = c("name" = "techn_field_nr")) %>%
  ggraph(layout = coords_tech) + 
  geom_edge_link(aes(width = weight), alpha = 0.2, colour = "grey") + 
  geom_node_point(aes(colour = rca, size = n_tech_region)) + 
  geom_node_text(aes(label = techn_field_name, size = rca, filter = rca >= 1), repel = TRUE) +
  scale_color_gradient2(low = "skyblue", mid = 'yellow', high = "red", midpoint = 1) +
  theme_graph() +
  labs(title =paste("Technology Space:", place, 'Period', time, sep = " "),
       subtitle = 'Nodes = Technology fields. Edges: Relatedness, Color = RTA')